module ZEMAX where

import Text.ParserCombinators.Parsec
import Data.Array
import Data.Fits.RecordParser (floating_value_Parser, integer_value_Parser)
import Control.Monad.Error

data PSF = PSF { centerDeg      :: (Double, Double),
                 cardinalPoint  :: (Double, Double),
                 centerPixel    :: (Int, Int),
                 pixelSize      :: Double,
                 waveLength     :: (Double, Double),
                 psfArray       :: Array (Int, Int) Double } deriving (Show)


data Distorsion = Distorsion { waveLengthDistorsion :: Double
                             , referenceCoordinate  :: (Double,Double)
                             , distorsionArray      :: Array (Int, Int) DistorsionVector
                             } deriving (Show)

type DistorsionVector = (Double, Double, Double, Double, Double, Double, Double, Double)

runP p s = let r = parse p "" s in
  case r of
     Left  e -> throwError $ strMsg $ show e  
     Right x -> return x

parseZEMAXPSF = do
  count 8 line
  wavelength  <- parseWaveLength
  spaces1 >> string "at" >> spaces1
  centerdeg   <- parseCenterDeg
  pixelsize   <- parsePixelSize
  count 3 line
  imagesize   <- parseImageSize
  centerpixel <- parsePixelCenter
  cardinal    <- parseCardinalPoint
  count 2 line
  psf         <- parsePSF imagesize
  return PSF { centerDeg     = centerdeg
             , cardinalPoint = cardinal
             , centerPixel   = centerpixel
             , pixelSize     = pixelsize
             , waveLength    = wavelength
             , psfArray      = psf
             } 

parsePSF (a,b) = do
  spaces
  x <- floating_value_Parser `endBy` (many space)
  return $ listArray ((1,1), (a, b)) x

parseWaveLength = do
  spaces1
  a <- tuple floating_value_Parser $ sep $ string "to"
  spaces1 >> string "µm"
  return a

parseCenterDeg = do
  spaces1
  a <- tuple floating_value_Parser $ sep $ string ","
  spaces1 >> string "(deg)." >> spaces1 >> newline1
  return a

parsePixelSize = do
  spaces1 >> string "Data spacing is" >> spaces1
  a <- floating_value_Parser
  spaces1 >> string "µm." >> spaces1 >> newline1
  return a

parsePixelCenter = do
  spaces1 >> string "Center point is:" >> spaces1
  (a,b) <- tuple integer_value_Parser $ sep $ char ','
  spaces1 >> newline1
  return (fromInteger a, fromInteger b)

parseImageSize = do
  spaces1 >> string "Image grid size:" >> spaces1
  (a,b) <- tuple integer_value_Parser $ sep $ string "by"
  spaces1 >> newline1
  return (fromInteger a, fromInteger b)

parseCardinalPoint = do
  spaces1 >> string "Center coordinates:" >> spaces1
  a <- tuple floating_value_Parser $ sep $ char ','
  spaces1 >> newline1
  return a

sep a = spaces1 >> a >> spaces1
tuple p s = do
  a <- p
  s
  b <- p
  return (a,b)

newline1 = try (char '\r' >> char '\n') <|> char '\n'

spaces1 = many $ char ' '

line = do
  x <- many $ noneOf "\n\r"
  newline1
  return x
{-
loadDistorsion :: FilePath -> IO (Either String Distorsion)
loadDistorsion f = do
  b <- readFile f
  return $ runP parseZEMAXDISTORSION b  
-}

parseZEMAXDISTORSION b = do
  count 9 line
  wavelength <- do string "Wavelength:" >> spaces1
                   w <- floating_value_Parser
                   spaces1 >> string "µm" >> spaces1 >> newline1
                   return w
  rcoordinate <- do string "Reference Coordinates: Xref = "
                    x <- floating_value_Parser
                    string ", Yref = "
                    y <- floating_value_Parser
                    spaces1 >> newline1
                    return (x,y) 
  count 2 line
  distorsion <- parseDistorsion b
  return $ Distorsion { waveLengthDistorsion = wavelength
                      , referenceCoordinate  = rcoordinate
                      , distorsionArray      = distorsion
                      }
 

parseDistorsion b = do
  x <- parseLineDistorsion `endBy` newline1
  return $ array b x  

parseLineDistorsion = do
  spaces1
  i <- integer_value_Parser
  spaces1
  j <- integer_value_Parser
  spaces1
  x1 <- floating_value_Parser
  spaces1
  x2 <- floating_value_Parser
  spaces1
  x3 <- floating_value_Parser
  spaces1
  x4 <- floating_value_Parser
  spaces1
  x5 <- floating_value_Parser
  spaces1
  x6 <- floating_value_Parser
  spaces1
  x7 <- floating_value_Parser
  spaces1
  x8 <- floating_value_Parser
  char '%'
  spaces1
  return ((fromInteger i + 6,fromInteger j +6), (x1,x2,x3,x4,x5,x6,x7,x8))